home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 011-020 / amok16 / rotateiff / rotate.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  262 lines

  1. (*---------------------------------------------------------------------------
  2.     :Program.    Rotate.mod
  3.     :Author.     Fridtjof Siebert
  4.     :Address.    Nobileweg 67, D-7-Stgt-40
  5.     :Phone.      0711/822509
  6.     :Shortcut.   [fbs]
  7.     :Version.    0.1
  8.     :Date.       19-Feb-88
  9.     :Copyright.  PD
  10.     :Language.   Modula-II
  11.     :Translator. M2Amiga v3.1d
  12.     :Imports.    IFFSupport.mod   [fbs], AMOK #6
  13.     :Imports.    ControlIntuition [fbs], AMOK #1
  14.     :Contents.   Small Graphics Demonstration
  15.     :Usage.      Rotate <IFF-Pic>
  16.     :Bugs.       Eats about 3K of memory. Sorry!
  17. ---------------------------------------------------------------------------*)
  18.  
  19. (* $S- $F- $N- $R- $V- *)
  20.  
  21. MODULE Rotate;
  22.  
  23. FROM SYSTEM           IMPORT INLINE, ADDRESS, ADR, CAST;
  24. FROM Arts             IMPORT TermProcedure, Terminate;
  25. FROM Arguments        IMPORT NumArgs, GetArg;
  26. FROM Exec             IMPORT FreeMem, AllocMem, MemReqs, MemReqSet;
  27. FROM Graphics         IMPORT BitMapPtr, BitMap, WaitBOVP, ViewPort, RasInfo,
  28.                              InitVPort, GetColorMap, FreeColorMap, View,
  29.                              InitView, MakeVPort, MrgCop, LoadView, ViewPtr,
  30.                              SetRGB4CM, FreeSprite, ViewModes, ViewModeSet,
  31.                              UCopList, FreeCopList;
  32. FROM GfxMacros        IMPORT CINIT, CMOVE, CWAIT, CEND;
  33. FROM Hardware         IMPORT custom;
  34. FROM Intuition        IMPORT ViewAddress, ScreenPtr, WindowPtr;
  35. FROM IFFSupport       IMPORT ReadILBM, ReadILBMFlags, ReadILBMFlagSet, NuScreen,
  36.                              IFFInfo;
  37. FROM ControlIntuition IMPORT DisableIntuition, EnableIntuition;
  38.  
  39. (* I'm sorry for my choatic programming style. So don't look at this source
  40.    if you want to keep your good style! *)
  41.  
  42. TYPE LI = LONGINT;
  43.  
  44. CONST
  45.   D0 = 0;
  46.   A0 = 8;
  47.   A1 = 9;
  48.  
  49. VAR
  50.   scr: ScreenPtr;
  51.   win: WindowPtr;
  52.   Name: ARRAY[0..79] OF CHAR;
  53.   length: INTEGER;
  54.   bitMap: BitMapPtr;
  55.   vBitMap: BitMap;
  56.   y,i,j,dx,p: LI;
  57.   a,b: ADDRESS;
  58.   Sinus: POINTER TO ARRAY[0..64] OF INTEGER;
  59.   SmallSine: POINTER TO ARRAY[0..31] OF CARDINAL;
  60.   MaxAdr: LI;
  61.   Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb);
  62.   vPort: ViewPort;
  63.   rInfo: RasInfo;
  64.   view: View;
  65.   iview: ViewPtr;
  66.   cList: UCopList;
  67.  
  68. PROCEDURE CopyBytes(num{D0}: INTEGER; from{A0},to{A1}: ADDRESS);
  69. BEGIN INLINE(
  70.   022D8H,051C8H,   (* loop: move.l (A0)+,(A1)+ *)
  71.   0FFFCH       );  (*       dbra   D0,loop     *)
  72. END CopyBytes;
  73.  
  74. (*------  Data:  ------*)
  75.  
  76. PROCEDURE Dat(); (* $E- Contains Data *)
  77. BEGIN INLINE(
  78.         0,  402,  804, 1205, 1606, 2006, 2404, 2801,   (*  0.. 7 *)
  79.      3196, 3590, 3981, 4370, 4756, 5139, 5520, 5897,   (*  8..15 *)
  80.      6270, 6640, 7005, 7366, 7723, 8076, 8423, 8765,   (* 16..23 *)
  81.      9102, 9434, 9760,10080,10394,10702,11003,11297,   (* 24..31 *)
  82.     11585,11866,12140,12406,12665,12916,13160,13395,   (* 32..39 *)
  83.     13623,13842,14053,14255,14449,14635,14811,14978,   (* 40..47 *)
  84.     15137,15286,15426,15557,15678,15790,15893,15986,   (* 48..55 *)
  85.     16069,16143,16207,16261,16305,16340,16364,16379,   (* 56..63 *)
  86.     16384);                                            (* 64     *)
  87. END Dat;
  88.  
  89. PROCEDURE Dat2(); (* $E- *)
  90. BEGIN
  91.   INLINE(8,9,11,12,13,14,15,15,15,15,14,13,12,11,9,8);
  92.   INLINE(7,6, 4, 3, 2, 1, 0, 0, 0, 0, 1, 2, 3, 4,6,7);
  93.  
  94. END Dat2;
  95.  
  96. (*------  CleanUp:  ------*)
  97.  
  98. PROCEDURE CleanUp();
  99.  
  100. VAR psize: LONGINT;
  101.  
  102. BEGIN
  103.   IF bitMap#NIL THEN
  104.     WITH bitMap^ DO
  105.       psize := LI(bytesPerRow) * LI(rows);
  106.       WHILE depth#0 DO DEC(depth); FreeMem(planes[depth],psize) END;
  107.       IF vBitMap.planes[0]#NIL THEN FreeMem(vBitMap.planes[0],psize) END;
  108.     END;
  109.     FreeMem(bitMap,SIZE(BitMap));
  110.   END;
  111.   IF vPort.uCopIns#NIL THEN FreeCopList(vPort.uCopIns^.firstCopList) END;
  112.   IF vPort.colorMap#NIL THEN FreeColorMap(vPort.colorMap) END;
  113.   IF iview#NIL THEN LoadView(iview) END;
  114. END CleanUp;
  115.  
  116. (*------  MAIN:  ------*)
  117.  
  118. BEGIN
  119.   Sinus := ADR(Dat);
  120.   SmallSine := ADR(Dat2);
  121.   bitMap := NIL; vBitMap.planes[0] := NIL; vPort.colorMap := NIL;
  122.   iview := NIL; vPort.uCopIns := NIL;
  123.   TermProcedure(CleanUp);
  124.  
  125.   IF NumArgs()#0 THEN GetArg(1,Name,length) ELSE Terminate(0) END;
  126.  
  127.   IF NOT ReadILBM(Name,ReadILBMFlagSet{front,dontopen,visible},scr,win) THEN
  128.     Terminate(0) END;
  129.  
  130.   bitMap := NuScreen.customBitMap;
  131.   WITH bitMap^ DO
  132.     vBitMap := bitMap^;
  133.     vBitMap.depth := 1;
  134.     vBitMap.planes[0] := AllocMem(LI(bytesPerRow)*LI(rows),MemReqSet{chip,memClear});
  135.     IF vBitMap.planes[0]=NIL THEN Terminate(0) END;
  136.  
  137.     InitVPort(vPort);
  138.     WITH vPort DO
  139.       next     := NIL;
  140.       colorMap := GetColorMap(2);
  141.       IF colorMap=NIL THEN Terminate(0) END;
  142.       WITH IFFInfo.CMAP DO
  143.         SetRGB4CM(colorMap,0,red[0],green[0],blue[0]);
  144.         SetRGB4CM(colorMap,1,red[1],green[1],blue[1]);
  145.       END;
  146.       dWidth   := NuScreen.width;
  147.       dHeight  := NuScreen.height;
  148.       modes    := NuScreen.viewModes;
  149.       dxOffset := 0;
  150.       dyOffset := 0;
  151.       rasInfo  := ADR(rInfo);
  152.       WITH rInfo DO
  153.         next     := NIL;
  154.         bitMap   := ADR(vBitMap);
  155.         rxOffset := 0;
  156.         ryOffset := 0;
  157.       END;
  158.       uCopIns := ADR(cList);
  159.  
  160.       WITH IFFInfo.CMAP DO
  161.         CINIT(uCopIns,800);
  162.         FOR i:=0 TO 7 DO
  163.           FOR j:=0 TO 15 DO
  164.             CWAIT(uCopIns,i*32+j,0);
  165.             CMOVE(uCopIns,ADR(custom.color[0]),
  166.               (15-j)*LI(red[0])/15*256+(15-j)*LI(green[0])/15*16+(15-j)*LI(blue[0])/15);
  167.             CMOVE(uCopIns,ADR(custom.color[1]),
  168.               j*LI(red[1])/15*256+j*LI(green[1])/15*16+j*LI(blue[1])/15);
  169.           END;
  170.           FOR j:=0 TO 15 DO
  171.             CWAIT(uCopIns,i*32+j+16,0);
  172.             CMOVE(uCopIns,ADR(custom.color[0]),
  173.               j*LI(red[0])/15*256+j*LI(green[0])/15*16+j*LI(blue[0])/15);
  174.             CMOVE(uCopIns,ADR(custom.color[1]),
  175.               (15-j)*LI(red[1])/15*256+(15-j)*LI(green[1])/15*16+(15-j)*LI(blue[1])/15);
  176.           END;
  177.         END;
  178.         CEND(uCopIns,1000,255);
  179.       END;
  180.     END;
  181.  
  182.     InitView(view);
  183.     view.modes := view.modes-ViewModeSet{sprites};
  184.     view.viewPort := ADR(vPort);
  185.  
  186.     iview := ViewAddress();
  187.     MakeVPort(ADR(view),ADR(vPort));
  188.     MrgCop(ADR(view));
  189.     LoadView(ADR(view));
  190.  
  191.     DisableIntuition; FreeSprite(0);
  192.  
  193.     MaxAdr := LI(vBitMap.planes[0]) + LI(bytesPerRow) * LI(rows);
  194.     LOOP
  195.       FOR i:=0 TO 63 BY 2 DO
  196.         a := planes[0]; b := vBitMap.planes[0];
  197.         dx:= Sinus^[64-i]; p := 0; y := rows;
  198.         INC(b,LI(bytesPerRow)*((LI(rows) - LI(rows) * LI(dx) / 16384)/2));
  199.         WHILE (y>0) AND (LI(b)<MaxAdr) DO
  200.           CopyBytes((bytesPerRow-4)/4,a,b);
  201.           INC(b,bytesPerRow);
  202.           INC(p,16384);
  203.           WHILE (p>dx) AND (y>0) DO
  204.             DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
  205.           END;
  206.         END;
  207.         IF NOT(lmb IN Ciapra) THEN EXIT END;
  208.         LoadView(ADR(view));
  209.       END;
  210.       FOR i:=0 TO 63 BY 2 DO
  211.         a := planes[0]; b := vBitMap.planes[0];
  212.         dx:= Sinus^[i]; p := 0; y := rows;
  213.         INC(b,LI(bytesPerRow)*(LI(rows) * (16384 + LI(dx)) / 32768));
  214.         WHILE (y>0) AND (LI(b)>LI(planes[0])) DO
  215.           DEC(b,bytesPerRow);
  216.           CopyBytes((bytesPerRow-4)/4,a,b);
  217.           INC(p,16384);
  218.           WHILE (p>dx) AND (y>0) DO
  219.             DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
  220.           END;
  221.         END;
  222.         IF NOT(lmb IN Ciapra) THEN EXIT END;
  223.         LoadView(ADR(view));
  224.       END;
  225.       FOR i:=0 TO 63 BY 2 DO
  226.         a := planes[0]; b := vBitMap.planes[0];
  227.         dx:= Sinus^[64-i]; p := 0; y := rows;
  228.         INC(b,LI(bytesPerRow)*(LI(rows) * (16384 + LI(dx)) / 32768));
  229.         WHILE (y>0) AND (LI(b)>LI(planes[0])) DO
  230.           DEC(b,bytesPerRow);
  231.           CopyBytes((bytesPerRow-4)/4,a,b);
  232.           INC(p,16384);
  233.           WHILE (p>dx) AND (y>0) DO
  234.             DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
  235.           END;
  236.         END;
  237.         IF NOT(lmb IN Ciapra) THEN EXIT END;
  238.         LoadView(ADR(view));
  239.       END;
  240.       FOR i:=0 TO 63 BY 2 DO
  241.         a := planes[0]; b := vBitMap.planes[0];
  242.         dx:= Sinus^[i]; p := 0; y := rows;
  243.         INC(b,LI(bytesPerRow)*(LI(rows) * (16384 - LI(dx)) / 32768));
  244.         WHILE (y>0) AND (LI(b)<MaxAdr) DO
  245.           CopyBytes((bytesPerRow-4)/4,a,b);
  246.           INC(b,bytesPerRow); INC(p,16384);
  247.           WHILE (p>dx) AND (y>0) DO
  248.             DEC(p,dx); DEC(y,1); INC(a,bytesPerRow);
  249.           END;
  250.         END;
  251.         IF NOT(lmb IN Ciapra) THEN EXIT END;
  252.         LoadView(ADR(view));
  253.       END;
  254.     END;
  255.   END;
  256.  
  257.   EnableIntuition;
  258.  
  259. END Rotate.
  260.  
  261.  
  262.